perm filename AUTO.XXX[1,JRA] blob sn#022405 filedate 1973-02-02 generic text, type T, neo UTF8
00100	
00200	
00300	(DEFPROP AUTO 
00400	 (LAMBDA(XX)
00500	  (PROG (X1 Z2 D M STRATEGY SUPPORT EDITSTRAT MERGE ORDER DEBUG ANCESTRY PMODEL NMODEL PFLG PDEPTH DLIST)
00600		(COND (EQUAL (SETQ PFLG NIL)) (T (SETQ PFLG NIL)))
00700		(SETQ PDEPTH 3)
00800		(SETQ DDEPTH 4)
01500		(SETQ X1 XX)
01600		(SETQ M (SETQ D 0))
01700	   A    (SETQ M (MAX M (LENGTH (CDAR X1))))
01800		(SETQ D (MAX D (DEPTH (CDAR X1))))
01900		(SETQ Z2 (CAR X1))
02000		(COND
02100		 ((AND (EQ (LENGTH (CDR Z2)) 1) (EQ (CAADR Z2) EQUAL) (NOT (EQ (CADADR Z2) (CAR (CDDADR Z2)))))
02200		  (SETQ DLIST (CONS (CONS (CONS (CAAAR Z2) (CDAR Z2)) (CDR Z2)) DLIST))))
02300		(SETQ X1 (CDR X1))
02400		(COND ((CDR X1) (GO A)))
02500		(SETQ Z2 (ASSOC (QUOTE THEOREM) NEWNAME))
02600		(COND ((NULL Z2) (GO C)) (T (SETQ Z2 (CDR Z2))))
02700	   B    (COND (Z2 (SETQ SUPPORT (CONS (CDAR Z2) SUPPORT)) (SETQ Z2 (CDR Z2)) (GO B)))
02800	   C    (COND ((NULL LENGTH) (SETQ LENGTH (DIFFERENCE (PLUS M (LENGTH (CDAR X1))) 2)))
02900		      ((ZEROP ITER) (SETQ LENGTH (ADD1 LENGTH))))
03000		(COND ((NOT (GREATERP LENGTH 0)) (SETQ LENGTH 1)))
03100		(COND ((NULL DEPTH) (SETQ DEPTH (ADD1 D))) ((NOT (ZEROP ITER)) (SETQ DEPTH (ADD1 DEPTH))))
03200		(COND ((ZEROP ITER) (SETQ ITER 1)) (T (SETQ ITER 0)))
03300		(COND (SUPPORT (SETQ STRATEGY (QUOTE (LAMBDA (C1 C2) (SUPPORT C2))))
03400			       (SETQ SAVESTR @(AND ANCESTRY (SUPPORT  THEOREM))))
03500		      (T (SETQ SAVESTR @ANCESTRY)))
03600		(SETQ ANCESTRY T)
03700		(SETQ EDITSTRAT
03800		      (QUOTE (LAMBDA (C) (OR (GREATERP (LENGTH (CDR C)) LENGTH) (GREATERP (DEPTH (CDR C)) DEPTH)))))
03900		(SETQ DEBUG T)
04000		(COND (DLIST (SET3 DLIST)))
04100		(RETURN
04200		 (LIST STRATEGY
04300	 	       SUPPORT
04400	 	       EDITSTRAT
04500	 	       MERGE
04600	 	       ORDER
04700	 	       DEBUG
04800	 	       DEPTH
04900	 	       LENGTH
05000	 	       ANCESTRY
05100	 	       PMODEL
05200	 	       NMODEL
05300	 	       PFLG
05400	 	       EQUAL
05500	 	       PDEPTH
05600	 	       DLIST)))) 
05700	EXPR)